home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
PGM_TOOL
/
PREVIEW
/
CLP2DLFI
/
WABOUTBX.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1995-11-10
|
7KB
|
246 lines
unit wAboutbx;
interface
uses
SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
Forms, Dialogs, StdCtrls;
type
TSetupBox = class(TForm)
ListBox1: TListBox;
Button1: TButton;
Button2: TButton;
Label1: TLabel;
wname: TEdit;
atpds: TCheckBox;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormActivate(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure wnameKeyPress(Sender: TObject; var Key: Char);
procedure atpdsKeyPress(Sender: TObject; var Key: Char);
private
{ Private declarations }
procedure Refresh;
function TypeName(ltype:string):string;
public
{ Public declarations }
end;
var
SetupBox: TSetupBox;
implementation
{$R *.DFM}
uses dbfserver, CommonCode, wPreview;
procedure TSetupBox.FormClose(Sender: TObject; var Action: TCloseAction);
begin
Gen.ReleaseWin(self);
if (pin('511045',Gen.Station)) or (pin('00012',Gen.Station))
then begin
gen.User:=wname.text+' ';
Gen.AtPDS:=atpds.checked;
gen.SetAccess;
end;
action:=cafree;
end;
procedure TSetupBox.Button1Click(Sender: TObject);
begin
close;
end;
procedure TSetupBox.FormCreate(Sender: TObject);
begin
left:=0;
top:=0;
width:=550;
height:=410;
centerhoriz(self);
Gen.AddWin('System Status',self);
if (pin('511045',Gen.Station)) or (pin('00012',Gen.Station))
then begin
wname.text:=trim(gen.User);
wname.visible:=true;
atpds.checked:=Gen.AtPDS;
atpds.visible:=true;
label1.visible:=true;
button2.visible:=true;
end;
end;
function TSetupBox.TypeName(ltype:string):string;
begin
{ ltype codes: "W"-Window open, see comcode.pas: FlagOn()
"R"-Routcard
"J"-Job Setup Change
"I"-In-process inspect.
"F"-Final inspect.
"S"-Shipper
"Q"-Shipper Request }
result:='';
if ltype='W' then result:='(Window Open)';
if ltype='R' then result:='(Route Card)';
if ltype='J' then result:='(Job)';
if ltype='I' then result:='(In-Process)';
if ltype='F' then result:='(Final Insp.)';
if ltype='S' then result:='(Shipper)';
if ltype='Q' then result:='(Shipper Request)';
result:=padr(result,18);
end;
procedure TSetupBox.Refresh;
var ii,jj:integer;
tt:string;
begin
listbox1.clear;
with listbox1 do begin
items.add(' Login Name: '+gen.user+' ('+gen.empnum+')');
items.add(' Station #: '+gen.station);
if not Gen.AtPDS then items.add('Running At: Precision Gage');
items.add('Main Directory: '+upper(jcpath('*')));
items.add(' Memory Total: '+ltrim(ltransform(memavail,'99,999,999'))+
', Largest Block: '+ltrim(ltransform(Maxavail,'99,999,999')));
items.add(' EXE Source: '+Gen.ExeSource);
items.add(' CDX Version: '+RocketVersion);
items.add('');
if not gen.CanBrowse then begin
if Gen.CanModifyCnt=0 then items.add('Can''t Browse Any Files')
else begin
with Gen do begin
if CanModifyCnt>0 then begin
items.add('Can Browse Following Files Only');
items.add(replicate('-',31));
for ii:=1 to CanModifyCnt do items.add(' '+CanModifyList[ii]);
end else items.add('Can''t Modify Any Files During Browse');
end;
end;
end else begin
if gen.CanBrowseModify then
items.add('Can Modify All Files During Browse')
else begin
with Gen do begin
if CanModifyCnt>0 then begin
items.add('Can Modify Following Files During Browse');
items.add(replicate('-',40));
for ii:=1 to CanModifyCnt do items.add(' '+CanModifyList[ii]);
end else items.add('Can''t Modify Any Files During Browse');
end;
end;
end;
items.add('');
with lp.LptPrinters[lp.curDest] do begin
items.add('Active Printer: '+
prName+' on '+PrPort+iifs(not empty(queue),'('+queue+')',''));
end;
items.add('');
items.add('Other Possible Printers');
items.add(replicate('-',23));
items.add('');
for ii:=1 to lp.PrnCnt do begin
DoEvents2;
with lp.LptPrinters[ii] do begin
if ii<>lp.CurDest then begin
tt:=' '+prName+' on '+PrPort+
iifs(not empty(queue),'('+queue+')','');
items.add(tt);
end;
end;
end;
items.add('');
items.add('Currently Formatting Reports');
items.add(replicate('-',28));
items.add('');
for ii:=1 to lp.PrnCnt do begin
DoEvents2;
if not empty(CurPrinting[ii]) then items.add(' '+CurPrinting[ii]);
end;
items.add('');
items.add('Active Windows');
items.add(replicate('-',14));
items.add('');
with Gen do begin
if MiscWinCnt>0 then begin
for ii:=1 to MiscWinCnt do items.add(' '+MiscWinList[ii].wClass);
end;
end;
items.add('');
items.add('Windows And Data In Use');
items.add(replicate('-',23));
items.add('');
with Gen.Multilok do begin
GoTop;
while not Gen.Multilok.Eof do begin
DoEvents2;
if not empty(s('lock_id')) then begin
tt:=' '+s('lock_id')+' '+typename(st('lock_type'));
if d('dated')>0 then begin
tt:=tt+' '+datehyph(d('dated'))+' '+s('attime');
end;
if pin(':',st('lock_id')) then begin
if pin(upper(trim(Gen.User)),s('lock_id')) then tt:='';
end;
if not empty(tt) then items.add(tt);
end;
Skip;
end;
end;
items.add('');
items.add('Databases Open');
items.add(replicate('-',14));
items.add('');
jj:=0;
for ii:=1 to 120 do begin
DoEvents2;
tt:=dbSelectArea(ii);
if not empty(tt) then begin
items.add(' Area '+transform(ii,'999')+' '+padr(tt,15)+DBFname[ii])
end else begin
pp(jj); { exit after finding 10 empty areas }
if jj>10 then break;
end;
end;
if Gen.DebugCnt>0 then begin
items.add('');
for ii:=1 to Gen.DebugCnt do begin
items.add(Gen.DebugList[ii]);
end;
Gen.DebugCnt:=0;
end;
end;
end;
procedure TSetupBox.FormActivate(Sender: TObject);
begin
Refresh;
end;
procedure TSetupBox.Button2Click(Sender: TObject);
begin
Refresh;
end;
procedure TSetupBox.wnameKeyPress(Sender: TObject; var Key: Char);
begin
if GetRet(key) then begin
Gen.User:=wname.text+' ';
Gen.SetAccess;
Refresh;
end;
end;
procedure TSetupBox.atpdsKeyPress(Sender: TObject; var Key: Char);
begin
if GetRet(key) then begin
Gen.AtPDS:=atpds.checked;
Refresh;
end;
end;
end.